home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / tcpech1a / modtcp.bas < prev    next >
BASIC Source File  |  1999-09-12  |  34KB  |  875 lines
  1. Attribute VB_Name = "TCP"
  2. Option Explicit
  3.  
  4. 'Constants
  5. Private Const BUFSIZE = 4096
  6. Private Const MyModule = "modMain"
  7. Private Const WSA_NoName = "Unknown"
  8. Private Const GWL_WNDPROC = (-4)
  9. Private Const GW_OWNER = 4
  10. Private Const WM_LBUTTONUP = &H202
  11. Private Const FD_SETSIZE = 64
  12. Private Const hostent_size = 16
  13. Private Const INADDR_NONE = &HFFFFFFFF
  14. Private Const INADDR_ANY = &H0
  15. Private Const sockaddr_size = 16
  16. Private Const WSA_DESCRIPTIONLEN = 256
  17. Private Const WSA_DescriptionSize = WSA_DESCRIPTIONLEN + 1
  18. Private Const WSA_SYS_STATUS_LEN = 128
  19. Private Const WSA_SysStatusSize = WSA_SYS_STATUS_LEN + 1
  20. Private Const INVALID_SOCKET = -1
  21. Private Const SOCKET_ERROR = -1
  22. Private Const SOCK_STREAM = 1
  23. Private Const AF_INET = 2
  24. Private Const WSAEWOULDBLOCK = 10035
  25. Private Const WSAEINPROGRESS = 10036
  26. Private Const FD_READ = &H1&
  27. Private Const FD_WRITE = &H2&
  28. Private Const FD_ACCEPT = &H8&
  29. Private Const FD_CONNECT = &H10&
  30. Private Const FD_CLOSE = &H20&
  31.  
  32. 'Types
  33. Private Type typeCallbackWindow
  34.     Name As String
  35.     hWnd As Long
  36.     Msg As Long
  37.     OldWindowProc As Long
  38. End Type
  39.  
  40. Private Type typeCallbacks
  41.     TCPConnect As typeCallbackWindow
  42.     CallbackClient As typeCallbackWindow
  43. End Type
  44.  
  45. Private Type fd_set
  46.     fd_count As Integer
  47.     fd_array(FD_SETSIZE) As Integer
  48. End Type
  49.  
  50. Private Type timeval
  51.     tv_sec As Long
  52.     tv_usec As Long
  53. End Type
  54.  
  55. Private Type HostEnt
  56.     h_name As Long
  57.     h_aliases As Long
  58.     h_addrtype As Integer
  59.     h_length As Integer
  60.     h_addr_list As Long
  61. End Type
  62.  
  63. Private Type sockaddr
  64.     sin_family As Integer
  65.     sin_port As Integer
  66.     sin_addr As Long
  67.     sin_zero As String * 8
  68. End Type
  69.  
  70. Private Type typeConnection
  71.     Index As Long
  72.     Socket As Long
  73.     Name As String
  74.     InUse As Long
  75.     ConnectBuffer As sockaddr
  76.     MsgQueue As String
  77.     Status As Long
  78.     StartTime As Long
  79. End Type
  80.  
  81. Private Type WSADataType
  82.     wVersion As Integer
  83.     wHighVersion As Integer
  84.     szDescription As String * WSA_DescriptionSize
  85.     szSystemStatus As String * WSA_SysStatusSize
  86.     iMaxSockets As Integer
  87.     iMaxUdpDg As Integer
  88.     lpVendorInfo As Long
  89. End Type
  90.  
  91. Private Type typeSocketLookup
  92.     Socket As Long
  93.     Index As Long
  94. End Type
  95.  
  96.  
  97. 'Variables
  98. Private Callbacks As typeCallbacks
  99. Public Connection(1 To 2000) As typeConnection
  100. Private SocketLookup() As typeSocketLookup
  101. Private SocketConnect As Long
  102. Private WSAStartedUp As Boolean
  103. Private MaxConnections As Long
  104.  
  105. 'Declares
  106. Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  107. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  108. Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
  109. Private Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb&)
  110. Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
  111. 'Private Declare Function accept Lib "wsock32.dll" (ByVal s As Long, addr As sockaddr, addrlen As Long) As Long
  112. 'Private Declare Function bind Lib "wsock32.dll" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long
  113. 'Private Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long
  114. 'Private Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer
  115. 'Private Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long
  116. 'Private Declare Function inet_ntoa Lib "wsock32.dll" (ByVal inn As Long) As Long
  117. 'Private Declare Function listen Lib "wsock32.dll" (ByVal s As Long, ByVal backlog As Long) As Long
  118. 'Private Declare Function recv Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Any) As Long  'removed ByVal from buf
  119. 'Private Declare Function send Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
  120. 'Private Declare Function Socket Lib "wsock32.dll" Alias "socket" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long
  121. 'Private Declare Function gethostbyname Lib "wsock32.dll" (ByVal host_name As String) As Long
  122. 'Private Declare Function gethostname Lib "wsock32.dll" (ByVal host_name As String, ByVal namelen As Long) As Long
  123. 'Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVR As Long, lpWSAD As WSADataType) As Long
  124. 'Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
  125. 'Private Declare Function WSAGetLastError Lib "wsock32.dll" () As Long
  126. 'Private Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, ByVal hWnd As Long, ByVal wMsg As Long, ByVal lEvent As Long) As Long
  127. Private Declare Function accept Lib "ws2_32.dll" (ByVal s As Long, addr As sockaddr, addrlen As Long) As Long
  128. Private Declare Function bind Lib "ws2_32.dll" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long
  129. Private Declare Function closesocket Lib "ws2_32.dll" (ByVal s As Long) As Long
  130. Private Declare Function htons Lib "ws2_32.dll" (ByVal hostshort As Long) As Integer
  131. Private Declare Function inet_addr Lib "ws2_32.dll" (ByVal cp As String) As Long
  132. Private Declare Function inet_ntoa Lib "ws2_32.dll" (ByVal inn As Long) As Long
  133. Private Declare Function listen Lib "ws2_32.dll" (ByVal s As Long, ByVal backlog As Long) As Long
  134. Private Declare Function recv Lib "ws2_32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Any) As Long  'removed ByVal from buf
  135. Private Declare Function send Lib "ws2_32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
  136. Private Declare Function Socket Lib "ws2_32.dll" Alias "socket" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long
  137. Private Declare Function gethostbyname Lib "ws2_32.dll" (ByVal host_name As String) As Long
  138. Private Declare Function gethostname Lib "ws2_32.dll" (ByVal host_name As String, ByVal namelen As Long) As Long
  139. Private Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVR As Long, lpWSAD As WSADataType) As Long
  140. Private Declare Function WSACleanup Lib "ws2_32.dll" () As Long
  141. Private Declare Function WSAGetLastError Lib "ws2_32.dll" () As Long
  142. Private Declare Function WSAAsyncSelect Lib "ws2_32.dll" (ByVal s As Long, ByVal hWnd As Long, ByVal wMsg As Long, ByVal lEvent As Long) As Long
  143.  
  144. Public Sub Init()
  145. '------------------------------------------------------------
  146. 'Initializes the connection array, starts up the listening socket
  147. '------------------------------------------------------------
  148.  
  149.     Const MyError = MyModule & "_" & "Init"
  150.     If Timings Then PerformanceStartTime MyError
  151.     On Error GoTo Err_Init
  152.     Dim i As Long, RetVal As Long
  153.     Dim numListen As Integer, PortNum As Integer
  154.     Dim MyName As String, SocketBuffer As sockaddr
  155.     
  156.     'Initialize the connection array
  157.     For i = 1 To UBound(Connection, 1)
  158.         Connection(i).InUse = 0
  159.         Connection(i).Index = i
  160.         Connection(i).Socket = 0
  161.     Next i
  162.     ReDim SocketLookup(1 To 1)
  163.     
  164.     'Start up sockets
  165.     WSAStartedUp = False
  166.     If StartWinsock() = False Then
  167.         CScreen.DebugText = "Error starting up sockets!"
  168.         GoTo Done
  169.     End If
  170.  
  171.     'Start up listening socket
  172.     PortNum = 7
  173.     SocketConnect = Socket(AF_INET, SOCK_STREAM, 0)
  174.     If SocketConnect < 1 Then
  175.         CScreen.DebugText = "Error starting up listening socket!"
  176.         GoTo Done
  177.     End If
  178.     SocketBuffer.sin_family = AF_INET
  179.     SocketBuffer.sin_port = htons(PortNum)
  180.     SocketBuffer.sin_addr = 0
  181.     SocketBuffer.sin_zero = String(8, 0)
  182.     RetVal = bind(SocketConnect, SocketBuffer, sockaddr_size)
  183.     If RetVal <> 0 Then
  184.         RetVal = WSACleanup()
  185.         CScreen.DebugText = "Failed to bind"
  186.         GoTo Done
  187.     End If
  188.     numListen = 5
  189.     RetVal = listen(ByVal SocketConnect, ByVal numListen)
  190.     RetVal = WSAAsyncSelect(SocketConnect, Callbacks.TCPConnect.hWnd, ByVal WM_LBUTTONUP, ByVal F